home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / GETKEY.INC < prev    next >
Text File  |  1991-09-14  |  757b  |  29 lines
  1. function GETKEY: integer;
  2.  
  3. { Wait for a single keypress from the keyboard. Valid keys are 1 thru 9. }
  4. var c: char;           { value from keypress }
  5.     Result: integer;   { result of keypress }
  6.  
  7. begin
  8.  
  9.   { clear keyboard buffer }
  10.   while keypressed do
  11.     c := readkey;
  12.  
  13.   { Pause for Keypress }
  14.   c := readkey;
  15.   if (c = #0) and (keypressed) then begin    { NUL character (fcn key) }
  16.     c := readkey;
  17.     { KVC 09/05/91 Removed function key support }
  18.     Result := -1;
  19.   end else if (ord(c) = 32) or (ord(c) = 27) then
  20.     { Treat a spacebar or escape like a 0 }
  21.     Result := 0
  22.   else
  23.     Result := ord(c) - 48;
  24.   if (Result >= 0) and (Result < 10) then
  25.     Getkey := Result
  26.   else
  27.     Getkey := -1;
  28. end; { function GETKEY }
  29.